home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / modem3.arc / MODEM3.PAS < prev   
Pascal/Delphi Source File  |  1989-03-19  |  15KB  |  649 lines

  1.  
  2. PROGRAM modem;
  3.       {Written by Jack M. Wierda  Chicago Illinois
  4.       This program is in the public domain.
  5.  
  6.       LANGUAGE: UCSD Pascal
  7.       FILES:    MODEM3.PAS -- main program
  8.                 MDM3-Z80IO.Z80 -- serial line interface for Z80
  9.                 MDM3-8080IO.Z80 -- serial line interface for Intel 8080
  10.  
  11.       This program is basically a re-write in PASCAL of Ward Christensen's
  12. Modem Program which was distributed in CP/M User's Group Volume 25. Identical
  13. and compatible options are provided to allow this program to work directly
  14. with Ward's program running under CP/M. One difference is that when sending
  15. files the PASCAL or CP/M transfer mode must be selected. The PASCAL mode
  16. transfers files between two systems running PASCAL, while the CP/M mode is
  17. used when the receiving system is running CP/M. Basically the CP/M mode
  18. provides the linefeeds required to make a PASCAL file compatible with CP/M.
  19. When CP/M files are received they contain linefeeds, these can be deleted
  20. using the editor to make the file compatible with PASCAL. CP/M files may also
  21. contain tabs which the PASCAL editor does not expand.
  22.       External assembly language routines are used to read the status, and read
  23. or write the keyboard and modem ports. These routines are available as
  24. separate files for the 8080 and Z80 processors. The port and flag definitions,
  25. and the timing constant for the one second delay should be changed as required
  26. for your particular hardware.
  27.       The program has been tested with text files only, and may not work
  28. correctly for code or other types of files.
  29.       The PDP-10 mode transfers PASCAL files to a DEC SYSTEM-10 computer.}
  30.  
  31. CONST 
  32.       nul = 0;
  33.       soh = 1;
  34.       ctrlc = 3;
  35.       eot = 4;
  36.       errormax = 5;
  37.       retrymax = 5;
  38.       ctrle = 5;
  39.       ack = 6;
  40.       tab = 9;
  41.       lf = 10;
  42.       cr = 13;
  43.       ctrlq = 17;
  44.       ctrls = 19;
  45.       nak = 21;
  46.       ctrlz = 26;
  47.       space = 32;
  48.       delete = 127;
  49.       lastbyte = 127;
  50.       timeout = 256;
  51.       loopspersec = 1800       {1800 LOOPS PER SECOND AT 4MHZ};
  52.       kbsp = 0           {KEYBOARD STATUS PORT};
  53.       kbdrf = 128        {KEYBOARD DATA READY FLAG};
  54.       kbdp = 1           {KEYBOARD DATA PORT};
  55.       kbmask = 127       {KEYBOARD DATA MASK};
  56.       dchdp = 128        {D. C. HAYES DATA PORT};
  57.       dchmask = 255      {D. C. HAYES DATA MASK};
  58.       dchsp = 129        {D. C. HAYES STATUS PORT};
  59.       {STATUS PORT BIT ASSIGNMENTS}
  60.       rrf     =    1   {RECEIVE REGISTER FULL};
  61.       tre     =    2   {TRANSMIT REGISTER EMPTY};
  62.       perr    =    4   {PARITY ERROR};
  63.       ferr    =    8   {FRAMING ERROR};
  64.       oerr    =    16  {OVERFLOW ERROR};
  65.       cd      =    64  {CARRIER DETECT};
  66.       nri     =    128 {NO RINGING INDICATOR};
  67.       dchcp1 = 129       {D. C. HAYES CONTROL PORT 1};
  68.       {CONTROL PORT 1 BIT ASSIGNMENTS}
  69.       epe     =    1   {EVEN PARITY ENABLE};
  70.       ls1     =    2   {LENGTH SELECT 1};
  71.       ls2     =    4   {LENGTH SELECT 2};
  72.       sbs     =    8   {STOP BIT SELECT};
  73.       pi      =    16  {PARITY INHIBIT};
  74.       dchcp2 = 130       {D. C. HAYES CONTROL PORT 2};
  75.       {CONTROL PORT 2 BIT ASSIGNMENTS}
  76.       brs     =    1   {BIT RATE SELECT};
  77.       txe     =    2   {TRANSMIT ENABLE};
  78.       ms      =    4   {MODE SELECT};
  79.       es      =    8   {ECHO SUPPRESS};
  80.       st      =    16  {SELF TEST};
  81.       rid     =    32  {RING INDICATOR DISABLE};
  82.       oh      =    128 {OFF HOOK};
  83.  
  84. VAR file1 : text;
  85.     option, hangup, return, mode, baudrate, display, filemode : char;
  86.     sector : ARRAY[0..lastbyte] OF integer;
  87.     dchcw2 : integer;
  88.     ovrn1, ovrn2, showrecv, showtrans : boolean;
  89.  
  90. FUNCTION stat(port,exr,mask:integer): boolean;
  91. external;
  92.  
  93. FUNCTION input(port,mask:integer): integer;
  94. external;
  95.  
  96. PROCEDURE output(port,data:integer);
  97. external;
  98.  
  99. PROCEDURE sendline(sldata:integer);
  100. BEGIN
  101.   REPEAT
  102.   UNTIL stat(dchsp,tre,tre);
  103.   output(dchdp,sldata);
  104.   IF showtrans
  105.   THEN
  106.     IF (sldata = cr) OR ((sldata >= space) AND (sldata <= delete))
  107.     THEN
  108.       write(chr(sldata))
  109. END;
  110.  
  111. FUNCTION readline(seconds:integer): integer;
  112.  
  113. VAR j : integer;
  114. BEGIN
  115.   j := loopspersec * seconds;
  116.   REPEAT
  117.     j := j-1
  118.   UNTIL (stat(dchsp,rrf,rrf)) OR (j = 0);
  119.   IF j = 0
  120.   THEN
  121.     readline := timeout
  122.   ELSE
  123.     BEGIN
  124.       j := input(dchdp,dchmask);
  125.       IF showrecv
  126.       THEN
  127.     IF (j = cr) OR ((j >= space) AND (j <= delete))
  128.     THEN
  129.       write(chr(j));
  130.       readline := j
  131.     END
  132. END;
  133.  
  134. PROCEDURE sendstr(str:string);
  135.  
  136. VAR j: integer;
  137. BEGIN
  138.   FOR j := 1 TO length(str) DO
  139.     sendline(ord(str[j]))
  140. END;
  141.  
  142. FUNCTION uppercase(ch : char) : char;
  143. BEGIN
  144.   IF ch IN ['a'..'z']
  145.   THEN
  146.     uppercase := chr(ord(ch)-space)
  147.   ELSE
  148.     uppercase := ch
  149. END;
  150.  
  151. PROCEDURE purgeline;
  152.  
  153. VAR j : integer;
  154. BEGIN
  155.   REPEAT
  156.     j := input(dchdp,dchmask)      {PURGE THE RECEIVE REGISTER};
  157.   UNTIL NOT stat(dchsp,rrf,rrf)
  158. END;
  159.  
  160. PROCEDURE dchinitialize;
  161. BEGIN
  162.   writeln('Waiting for carrier');
  163.   REPEAT
  164.     BEGIN
  165.       IF option IN ['R','S']
  166.       THEN
  167.     BEGIN
  168.       output(dchcp1,pi+ls2+ls1);
  169.       output(dchcp2,oh+rid+txe+dchcw2)
  170.     END;
  171.       IF option IN ['C','P','T']
  172.       THEN
  173.     BEGIN
  174.       output(dchcp1,ls2+epe);
  175.       output(dchcp2,oh+rid+txe+dchcw2)
  176.     END
  177.     END
  178.   UNTIL (stat(dchsp,cd,cd)) OR (input(kbdp,kbmask) = ctrle);
  179.   purgeline;
  180.   writeln('Carrier detected')
  181. END;
  182.  
  183. PROCEDURE makesector;
  184.  
  185. VAR j : integer;
  186.     ch : char;
  187. BEGIN
  188.   j := 0;
  189.   IF ovrn1
  190.   THEN
  191.     BEGIN
  192.       sector[j] := cr;
  193.       j := j+1
  194.     END;
  195.   IF ovrn2
  196.   THEN
  197.     BEGIN
  198.       sector[j] := lf;
  199.       j := j+1
  200.     END;
  201.   ovrn1 := false;
  202.   ovrn2 := false;
  203.   WHILE (NOT eof(file1)) AND (j <= lastbyte) DO
  204.     BEGIN
  205.       WHILE (NOT eoln(file1)) AND (j <= lastbyte) DO
  206.     BEGIN
  207.       read(file1,ch);
  208.       IF ord(ch) <> lf
  209.       THEN
  210.         BEGIN
  211.           sector[j] := ord(ch);
  212.           j := j+1
  213.         END
  214.     END;
  215.       IF eoln(file1)
  216.       THEN
  217.     BEGIN
  218.       readln(file1);
  219.       IF filemode IN ['P']
  220.       THEN
  221.         IF j <= lastbyte
  222.         THEN
  223.           BEGIN
  224.         sector[j] := cr;
  225.         j := j+1
  226.           END
  227.         ELSE
  228.           ovrn1 := true
  229.       ELSE
  230.         BEGIN
  231.           IF j <= (lastbyte-1)
  232.           THEN
  233.         BEGIN
  234.           sector[j] := cr;
  235.           sector[j+1] := lf;
  236.           j := j+2
  237.         END
  238.           ELSE
  239.         IF j = lastbyte
  240.         THEN
  241.           BEGIN
  242.             sector[j] := cr;
  243.             j := j+1;
  244.             ovrn1 := true
  245.           END
  246.         ELSE
  247.           IF j > lastbyte
  248.           THEN
  249.             BEGIN
  250.               ovrn1 := true;
  251.               ovrn2 := true
  252.             END
  253.         END
  254.     END
  255.     END;
  256.   CASE filemode OF
  257.     'P' : IF j <= lastbyte
  258.       THEN
  259.         FOR j := j TO lastbyte DO
  260.           sector[j] := space;
  261.     'C' : IF j <= lastbyte
  262.       THEN
  263.         FOR j := j TO lastbyte DO
  264.           sector[j] := ctrlz
  265.   END
  266. END;
  267.  
  268. PROCEDURE termcomp;
  269.  
  270. VAR kbdata, dchdata : integer;
  271.     crflag : boolean;
  272. BEGIN
  273.   crflag := false;
  274.   dchinitialize;
  275.   WHILE stat(dchsp,cd,cd) AND (kbdata <> ctrle) DO
  276.     BEGIN
  277.       IF stat(kbsp,kbdrf,kbdrf)
  278.       THEN
  279.     BEGIN
  280.       kbdata := input(kbdp,kbmask);
  281.       IF option IN ['C']
  282.       THEN
  283.         write(chr(kbdata));
  284.       output(dchdp,kbdata)
  285.     END;
  286.       IF stat(dchsp,rrf,rrf)
  287.       THEN
  288.     BEGIN
  289.       dchdata := input(dchdp,dchmask);
  290.       IF option IN ['C']
  291.       THEN
  292.         output(dchdp,dchdata);
  293.       IF dchdata = cr
  294.       THEN
  295.         crflag := true;
  296.       IF (dchdata = lf) AND crflag
  297.       THEN
  298.         crflag := false
  299.       ELSE
  300.         write(chr(dchdata))
  301.     END
  302.     END
  303. END;
  304.  
  305. PROCEDURE pdp10;
  306.  
  307. VAR wait10 : boolean;
  308.     dchdata : integer;
  309.     ch : char;
  310.     filename, pdp10file : string;
  311. BEGIN
  312.   showrecv := false;
  313.   showtrans := true;
  314.   wait10 := false;
  315.   write('Filename.Ext ? ');
  316.   readln(filename);
  317.   reset(file1,filename);
  318.   IF option IN ['P']
  319.   THEN
  320.     BEGIN
  321.       write('PDP-10 Filename.Ext ? ');
  322.       readln(pdp10file);
  323.       dchinitialize;
  324.       sendline(cr);
  325.       sendstr('R PIP');
  326.       sendline(cr);
  327.       REPEAT
  328.       UNTIL readline(5) IN [ord('*'),timeout];
  329.       sendstr(pdp10file);
  330.       sendstr('=TTY:');
  331.       sendline(cr)
  332.     END
  333.   ELSE
  334.     BEGIN
  335.       write('UNIX Filename.Ext ? ');
  336.       readln(pdp10file);
  337.       dchinitialize;
  338.       sendline(cr);
  339.       sendstr('cat > ');
  340.       sendstr(pdp10file);
  341.       sendline(cr)
  342.     END;
  343.   WHILE (NOT eof(file1)) AND (stat(dchsp,cd,cd)) DO
  344.     BEGIN
  345.       WHILE NOT eoln(file1) DO
  346.     BEGIN
  347.       IF NOT wait10
  348.       THEN
  349.         BEGIN
  350.           read(file1,ch);
  351.           sendline(ord(ch))
  352.         END;
  353.       IF stat(dchsp,rrf,rrf)
  354.       THEN
  355.         BEGIN
  356.           dchdata := input(dchdp,dchmask);
  357.           IF dchdata = ctrls
  358.           THEN
  359.         wait10 := true;
  360.           IF dchdata = ctrlq
  361.           THEN
  362.         wait10 := false
  363.         END
  364.     END;
  365.       readln(file1);
  366.       sendline(cr)
  367.     END;
  368.   close(file1);
  369.   REPEAT
  370.   UNTIL readline(1)=timeout;
  371.   IF option IN ['P']
  372.   THEN
  373.     BEGIN
  374.       sendline(ctrlz);
  375.       sendline(ctrlc);
  376.     END
  377.   ELSE
  378.     BEGIN
  379.       sendline(eot)
  380.     END;
  381.   termcomp
  382. END;
  383.  
  384. PROCEDURE sendfile;
  385.  
  386. VAR j, k, sectornum, counter, checksum : integer;
  387.     filename : string;
  388. BEGIN
  389.   write('Filename.Ext ? ');
  390.   readln(filename);
  391.   reset(file1,filename);
  392.   sectornum := 1;
  393.   dchinitialize;
  394.   ovrn1 := false;
  395.   ovrn2 := false;
  396.   REPEAT
  397.     counter := 0;
  398.     makesector;
  399.     REPEAT
  400.       writeln;
  401.       writeln('Sending sector ', sectornum);
  402.       sendline(soh);
  403.       sendline(sectornum);
  404.       sendline(-sectornum-1);
  405.       checksum := 0;
  406.       FOR j := 0 TO lastbyte DO
  407.     BEGIN
  408.       sendline(sector[j]);
  409.       checksum := (checksum + sector[j]) MOD 256
  410.     END;
  411.       sendline(checksum);
  412.       purgeline;
  413.       counter := counter + 1;
  414.     UNTIL (readline(10) = ack) OR (counter = retrymax);
  415.     sectornum := sectornum + 1
  416.   UNTIL (eof(file1)) OR (counter = retrymax);
  417.   IF counter = retrymax
  418.   THEN
  419.     BEGIN
  420.       writeln;
  421.       writeln('No ACK on sector')
  422.     END
  423.   ELSE
  424.     BEGIN
  425.       counter := 0;
  426.       REPEAT
  427.     sendline(eot);
  428.     counter := counter + 1
  429.       UNTIL (readline(10) = ack) OR (counter = retrymax);
  430.       IF counter = retrymax
  431.       THEN
  432.     BEGIN
  433.       writeln;
  434.       writeln('No ACK on EOT')
  435.     END
  436.       ELSE
  437.     BEGIN
  438.       writeln;
  439.       writeln('Transfer complete')
  440.     END
  441.     END;
  442.   close(file1)
  443. END;
  444.  
  445. PROCEDURE readfile;
  446.  
  447. VAR j, firstchar, sectornum,sectorcurrent, sectorcomp, errors,
  448.     checksum : integer;
  449.     errorflag : boolean;
  450.     filename : string;
  451. BEGIN
  452.   write('Filename.Ext ? ');
  453.   readln(filename);
  454.   rewrite(file1,filename);
  455.   sectornum := 0;
  456.   errors := 0;
  457.   dchinitialize;
  458.   sendline(nak);
  459.   sendline(nak);
  460.   REPEAT
  461.     errorflag := false;
  462.       REPEAT
  463.     firstchar := readline(20)
  464.       UNTIL firstchar IN [soh,eot,timeout];
  465.     IF firstchar = timeout
  466.     THEN
  467.       BEGIN
  468.     writeln;
  469.     writeln('SOH error');
  470.       END;
  471.     IF firstchar = soh
  472.     THEN
  473.       BEGIN
  474.     sectorcurrent := readline(1);
  475.     sectorcomp := readline(1);
  476.     IF (sectorcurrent+sectorcomp)=255
  477.     THEN
  478.       BEGIN
  479.         IF (sectorcurrent=sectornum+1)
  480.         THEN
  481.           BEGIN
  482.         checksum := 0;
  483.         FOR j := 0 TO lastbyte DO
  484.           BEGIN
  485.             sector[j] := readline(1);
  486.             checksum := (checksum+sector[j]) MOD 256
  487.           END;
  488.         IF checksum=readline(1)
  489.         THEN
  490.           BEGIN
  491.             FOR j := 0 TO lastbyte DO
  492.               write(file1,chr(sector[j]));
  493.             errors := 0;
  494.             sectornum := sectorcurrent;
  495.             IF display <> 'R'
  496.             THEN
  497.               BEGIN
  498.             writeln;
  499.             writeln('Received sector ',sectorcurrent)
  500.               END;
  501.             sendline(ack)
  502.           END
  503.         ELSE
  504.           BEGIN
  505.             writeln;
  506.             writeln('Checksum error');
  507.             errorflag := true
  508.           END
  509.           END
  510.         ELSE
  511.           IF (sectorcurrent=sectornum)
  512.           THEN
  513.         BEGIN
  514.           REPEAT
  515.           UNTIL readline(1)=timeout;
  516.           writeln;
  517.           writeln('Received duplicate sector ', sectorcurrent);
  518.           sendline(ack)
  519.         END
  520.           ELSE
  521.         BEGIN
  522.           writeln;
  523.           writeln('Synchronization error');
  524.           errorflag := true
  525.         END
  526.       END
  527.     ELSE
  528.       BEGIN
  529.         writeln;
  530.         writeln('Sector number error');
  531.         errorflag := true
  532.       END
  533.       END;
  534.     IF (errorflag=true)
  535.     THEN
  536.       BEGIN
  537.     errors := errors+1;
  538.     REPEAT
  539.     UNTIL readline(1)=timeout;
  540.     sendline(nak)
  541.       END;
  542.   UNTIL (firstchar IN [eot,timeout]) OR (errors = errormax);
  543.   IF (firstchar = eot) AND (errors < errormax)
  544.   THEN
  545.     BEGIN
  546.       sendline(ack);
  547.       close(file1,lock);
  548.       writeln;
  549.       writeln('Transfer complete')
  550.     END
  551.   ELSE
  552.     BEGIN
  553.       close(file1);
  554.       writeln;
  555.       writeln('Aborting')
  556.     END
  557. END;
  558. BEGIN
  559.   writeln('Modem, 7-July-79');
  560.   REPEAT
  561.     REPEAT
  562.       write('Option : C(omputer), P(DP-10), R(eceive), S(end), T(erminal)');
  563.       write(', U(nix) ? ');
  564.       read(option);
  565.       option := uppercase(option);
  566.       writeln
  567.     UNTIL option IN ['C','P','R','S','T','U'];
  568.     REPEAT
  569.       write('Mode : A(nswer), O(riginate) ? ');
  570.       read(mode);
  571.       mode := uppercase(mode);
  572.       writeln
  573.     UNTIL mode IN ['A','O'];
  574.     IF mode IN ['O']
  575.     THEN
  576.       dchcw2 := ms
  577.     ELSE
  578.       dchcw2 := 0;
  579.     REPEAT
  580.       write('Baud rate : 1(00), 3(00) ? ');
  581.       read(baudrate);
  582.       writeln
  583.     UNTIL baudrate IN ['1','3'];
  584.     IF baudrate='3'
  585.     THEN
  586.       dchcw2 := dchcw2+brs;
  587.     IF option IN ['R','S']
  588.     THEN
  589.       BEGIN
  590.     REPEAT
  591.       write('Display : N(o), R(eceived), T(ransmitted) data ? ');
  592.       read(display);
  593.       display := uppercase(display);
  594.       writeln
  595.     UNTIL display IN ['N','R','T'];
  596.     IF option = 'S'
  597.     THEN
  598.       BEGIN
  599.         REPEAT
  600.           write('File mode : C(pm), P(ascal) ? ');
  601.           read(filemode);
  602.           filemode := uppercase(filemode);
  603.           writeln
  604.         UNTIL filemode IN ['C','P']
  605.       END;
  606.     CASE display OF
  607.       'N': BEGIN
  608.          showrecv := false;
  609.          showtrans := false
  610.            END;
  611.       'R': BEGIN
  612.          showrecv := true;
  613.          showtrans := false
  614.            END;
  615.       'T': BEGIN
  616.          showrecv := false;
  617.          showtrans := true
  618.            END
  619.     END
  620.       END;
  621.     CASE option OF
  622.       'C': termcomp;
  623.       'P': pdp10;
  624.       'R': readfile;
  625.       'S': sendfile;
  626.       'T': termcomp;
  627.       'U': pdp10
  628.     END;
  629.     REPEAT
  630.       writeln;
  631.       write('Hangup : Y(es), N(o) ? ');
  632.       read(hangup);
  633.       hangup := uppercase(hangup);
  634.       writeln
  635.     UNTIL hangup IN ['Y','N'];
  636.     IF hangup IN ['Y']
  637.     THEN
  638.       output(dchcp2,0);
  639.     REPEAT
  640.       writeln;
  641.       write('Return to system : Y(es), N(o) ? ');
  642.       read(return);
  643.       return := uppercase(return);
  644.       writeln
  645.     UNTIL return IN ['Y','N'];
  646.   UNTIL return IN ['Y']
  647. END
  648. .
  649.